home *** CD-ROM | disk | FTP | other *** search
Text File | 1988-01-11 | 12.6 KB | 576 lines | [TEXT/MPS ] |
- TITLE 'Test of pump driver'
- Case ON
- BLANKS ON
- Machine MC68020
-
- PRINT OFF
- INCLUDE 'Traps.a'
- INCLUDE 'ToolEqu.a'
- INCLUDE 'QuickEqu.a'
- INCLUDE 'SysEqu.a'
- INCLUDE 'SysErr.a'
- INCLUDE 'TimeEqu.a'
- INCLUDE 'Quickdraw.inc'
- INCLUDE 'PumpErrs.inc'
- LOAD 'ProgStrucMacs.d'
- LOAD 'FlowCtlMacs.d'
- PRINT ON
-
- DgInfo Record
- PumpAction DS.W 1
- PumpRequest DS.W 1
- PumpInfo DS.W 1
- DCEntry DS.L 1
- PumpDriverRef DS.W 1
- DriverQueue DS.L 1
- EndR
-
- ItemStuff Record
- itemType DS.W 1
- itemHdl DS.L 1
- itemRect DS.W Rect
- itemHit DS.W 1
- myEvent DS.L EventRecord ; Current event info
- DialogPtr DS.L 1
- Done DS.W 1
- EndR
-
-
- theDialog EQU A3 ;Dialog pointer
- TestDLOG EQU 128 ;Resource ID for the dialog
-
- QuitButton equ 2
- ActionButton equ 1
- S_Button equ 3
- R_Button equ 4
- V_Button equ 5
- I_Button equ 6
- Num_Button equ 7
- Ask_Button equ 8
- Set_Button equ 9
- In_Field equ 10
- Out_Field equ 11
-
- ParamBlockSize equ 108
-
- ActionOffset equ csParam
- RequestOffset equ csParam+2
- InfoOffset equ csParam+4
-
- Ask equ 0
- Set equ 1
-
- S_request equ 0
- R_request equ 1
- V_request equ 2
- I_request equ 3
- Num_request equ 4
-
- StatusAbnormal equ 200
- RateReply equ 201
- VolumeReply equ 202
- InfusedReply equ 203
- InvalidRequest equ 204
- RdTmOut equ 205
- WrTmOut equ 206
- TooMany equ 207
- UnDecode equ 208
- UnkAction equ 209
- UnkRequest equ 210
- Misread equ 211
- StatusSet equ 212
- RateSet equ 213
- VolumeSet equ 214
- InfusedSet equ 215
- PumpInitialized equ 216
- BadProblem equ 217
- StatusNormal equ 218
- Exiting equ 219
-
- Procedure SetRequestButton
-
- Begin Save=D3-D4,with=(ItemStuff);
-
- MOVE.W D0,D4
- For# D3 = #S_Button To #Num_Button Do.S
- Call _GetDItem (theDialog:L,D3:W,itemType:A,itemHdl:A,itemRect:A)
- If# D3 EQ.W D4 Then.S
- Call _SetCtlValue ( itemHdl:L , #1:W )
- Else#.S
- Call _SetCtlValue ( itemHdl:L , #0:W )
- EndIf#
- EndF#
- MOVE.W D4,D0
-
- Return
- ENDP
-
- Procedure SetActionButton
-
- Begin Save=D3,with=(ItemStuff);
-
-
- MOVE.W D0,D3
- If# D3 EQ.W #Ask_Button Then.S
- Call _GetDItem (theDialog:L,#Ask_Button:W,itemType:A,itemHdl:A,\
- itemRect:A)
- Call _SetCtlValue ( itemHdl:L , #1:W )
- Call _GetDItem (theDialog:L,#Set_Button:W,itemType:A,itemHdl:A,\
- itemRect:A)
- Call _SetCtlValue ( itemHdl:L , #0:W )
- ElseIf#.S D3 EQ.W #Set_Button Then.S
- Call _GetDItem (theDialog:L,#Set_Button:W,itemType:A,itemHdl:A,\
- itemRect:A)
- Call _SetCtlValue ( itemHdl:L , #1:W )
- Call _GetDItem (theDialog:L,#Ask_Button:W,itemType:A,itemHdl:A,\
- itemRect:A)
- Call _SetCtlValue ( itemHdl:L , #0:W )
- EndIf#
- MOVE.W D3,D0
-
- Return
- ENDP
-
- Procedure HexDecode
-
- Begin Save=D1-D3/A1,With=(DgInfo);
-
-
- CLR.W D2
- MOVE.B (A0)+,D3 ;Get the length byte
- EXT.W D3
- EXT.L D3
- SUBQ.L #2,D3
- ADDQ.L #1,A0 ;Toss the dollar sign
- For# D3 DownTo #0 Do.S
-
- MOVE.B (A0)+,D1
- EXT.W D1
-
- Switch# D1
- Case#.S '0'..'9'
- SUB.B #'0',D1
- Leave#.S
- Case#.S 'A'..'F'
- SUB.B #'A'-10,D1
- Leave#.S
- Case#.S 'a'..'f'
- SUB.B #'a'-10,D1
- Leave#.S
- Default#
- call _SelIText ( theDialog:L , #In_Field:W , #0:W , #32767:W )
- call _SysBeep ( #3:W )
- MOVE.W #-1,D0
- Return
- EndS#
-
-
- FoundIt LSL.W #4,D2
- ADD.W D1,D2
- EndF#
-
- MOVE.W D2,PumpInfo
- MOVE.W #0,D0
- Return
-
- Return
-
- ; STRING ASIS
- ;Table1Base DC.B '0123456789ABCDEF'
-
- ENDP
-
- MACRO
- StringToNum
- MOVE.W #1,-(SP)
- _Pack7
- ENDM
-
- Procedure IntegerDecode
-
- Begin Save=D1-D2,With=(DgInfo);
-
- CLR.W D1
-
- MOVE.B (A0)+,D2 ;Get the length byte
- EXT.W D2
- EXT.L D2
- SUBQ.L #1,D2
- For# D2 DownTo #0 Do.S
-
- MOVE.B (A0)+,D0
- SUB.B #'0',D0
- If# MI OR D0 GT.B #9 Then.S
- GoTo#.S Bad
- EndIf#
- EXT.W D0
- MULU.W #10,D1
- ADD.W D0,D1
- EndF#
-
- MOVE.W D1,PumpInfo
- MOVE.W #0,D0
- Return
-
- Bad call _SelIText ( theDialog:L , #In_Field:W , #0:W , #32767:W )
- call _SysBeep ( #3:W )
- MOVE.W #-1,D0
-
- Return
- ENDP
-
- Procedure ActionProc
-
- Var TempString:B[256];
- Begin Save=D0/A0-A1,With=(DgInfo,ItemStuff);
-
- If# PumpAction EQ.W #Set Then.S
- Call _GetDItem (theDialog:L,#In_Field:W,itemType:A,itemHdl:A,\
- itemRect:A)
- Call _GetIText ( itemHdl:L , TempString(FP):A )
- LEA TempString(FP),A0
- If# (A0) EQ.B #0 OR (A0) EQ.W #$0124 Then.S ;$0124 = Char(1)//'$'
- MOVE.W #0,PumpInfo
- Else#.S
- If# 1(A0) EQ.B #'$' Then.S
- Call HexDecode
- Else#.S
- Call IntegerDecode
- EndIf#
- If# D0 NE.W #0 Then.S
- Return
- EndIf#
- EndIf#
- Else#.S
- MOVE.W #0,PumpInfo
- EndIf#
-
- *
- * Set up the parameter block for the control call
- *
-
- MOVE.L #ParamBlockSize,D0
- _NewPtr ,clear
- MOVE.W PumpDriverRef,ioRefNum(A0)
- MOVE.W PumpAction,ActionOffset(A0)
- MOVE.W PumpRequest,RequestOffset(A0)
- MOVE.W PumpInfo,InfoOffset(A0)
- CLR.L ioCompletion(A0)
- _Status ,async
-
- If# D0 NE.W #0 Then.S
- Call _GetDItem (theDialog:L,#Out_Field:W,itemType:A,itemHdl:A,\
- itemRect:A)
- Call _SetItext ( itemHdl:L , #'Driver unable to handle this call':A )
- EndIf#
-
- Return
- ENDP
-
- Procedure EventProc ( The_message:L )
-
- Var TempString:B[256];
- Begin Save=D0/A0-A2,With=(DgInfo,ItemStuff);
-
- MACRO
- NumToString
- CLR.W -(SP)
- _Pack7
- ENDM
-
- MOVE.L The_message(FP),A0
-
- * The message is a parameter block pointer for the just completed pump driver call. First,
- * check to see that the request completed without an error state.
-
- MOVE.W ioResult(A0),D0
- If# EQ Then
- MOVE.L A0,A2
- If# ActionOffset(A0) EQ.W #Set Then.S
- MOVE.W RequestOffset(A0),D0
- Switch# D0,JmpTbl=Y
- Case#.S S_request
- MOVE.W #StatusSet,D3
- Leave#.S
- Case#.S R_request
- MOVE.W #RateSet,D3
- Leave#.S
- Case#.S V_request
- MOVE.W #VolumeSet,D3
- Leave#.S
- Case#.S I_request
- MOVE.W #InfusedSet,D3
- Leave#.S
- Case#.S Num_request
- MOVE.W #PumpInitialized,D3
- Leave#.S
- Default#.S
- MOVE.W #BadProblem,D3
- EndS#
- Call _GetString:L ( D3:W ),A0
- _HLock
- MOVE.L (A0),A1
- Else#
- MOVE.W RequestOffset(A0),D0
- Switch# D0,JmpTbl=Y
- Case#.S S_request
- MOVE.W InfoOffset(A2),D1
- AND.W #$000F,D1
- If# D1 EQ.W #0 Then.S
- MOVE.L #StatusNormal,D3
- Call _GetString:L ( D3:W ),A0
- _HLock
- MOVE.L (A0),A1
- Else#.S
- MOVE.L #StatusAbnormal,D3
- Call _GetString:L ( D3:W ),A0
- _HLock
- MOVE.L (A0),A1
- CLR.W D4
- For# D2 = #3 DownTo #0 Do.S
- BTST D2,D1
- If# EQ Then.S
- LEA #'AOIB',A0
- MOVE.B (A0,D2.W),21(A1,D4.W)
- ADDQ.W #1,D4
- EndIf#
- EndF#
- EndIf#
- GoTo#.S StatusOut
- Case#.S R_request
- MOVE.L #RateReply,D3
- Leave#.S
- Case#.S V_request
- MOVE.L #VolumeReply,D3
- Leave#.S
- Case#.S I_request
- MOVE.L #InfusedReply,D3
- Leave#.S
- Case#.S Num_request
- MOVE.L #InvalidRequest,D3
- Call _GetString:L ( D3:W ),A0
- _HLock
- MOVE.L (A0),A1
- GoTo#.S StatusOut
- Default#.S
- MOVE.L #BadProblem,D3
- EndS#
-
- Call _GetString:L ( D3:W ),A0
- _HLock
- MOVE.L (A0),A1
- MOVE.L A1,-(SP)
-
- MOVE.W InfoOffset(A2),D0
- EXT.L D0
- LEA TempString(FP),A0
- NumToString
- MOVE.B (A0)+,D0
- MOVE.B (A1),D1
- SUB.B D0,D1
- EXT.W D1
- EXT.W D0
- EXT.L D0
- LEA (A1,D1.W),A1
- _BlockMove
- MOVE.L (SP)+,A1
- StatusOut:
- EndIf#
- Else#
- MOVE.W ioResult(A0),D0
- Switch# D0
- Case#.S statusErr
- MOVE.W #Exiting,D3
- Leave#.S
- Case#.S TimeOut+aRdCmd
- MOVE.L #RdTmOut,D3
- Leave#.S
- Case#.S TimeOut+aWrCmd
- MOVE.L #WrTmOut,D3
- Leave#.S
- Case#.S TooManyCharacters
- MOVE.L #TooMany,D3
- Leave#.S
- Case#.S PumpUndecodableNumber
- MOVE.L #UnDecode,D3
- Leave#.S
- Case#.S PumpUnknownAction
- MOVE.L #UnkAction,D3
- Leave#.S
- Case#.S PumpUnknownRequest
- MOVE.L #UnkRequest,D3
- Leave#.S
- Case#.S PumpMisread
- MOVE.L #Misread,D3
- Leave#.S
- Default#.S
- MOVE.W #BadProblem,D3
- EndS#
-
- Call _GetString:L ( D3:W ),A0
- _HLock
- MOVE.L (A0),A1
- MOVE.L A1,-(SP)
-
- MOVE.W ioResult(A2),D0
- EXT.L D0
- LEA TempString(FP),A0
- NumToString
- MOVE.B (A0)+,D0
- MOVE.B (A1),D1
- SUB.B D0,D1
- EXT.W D1
- EXT.W D0
- EXT.L D0
- LEA (A1,D1.W),A1
- _BlockMove
- MOVE.L (SP)+,A1
-
- EndIf#
- MOVE.L A2,A0
- _DisposPtr
- MOVE.L A1,A2
- Call _GetDItem (theDialog:L,#Out_Field:W,itemType:A,itemHdl:A,\
- itemRect:A)
- Call _SetItext ( itemHdl:L , A2:L )
-
- Return
- ENDP
-
- Procedure Test,MAIN=Y
- Var theID:W , theType:B[4] , theName:B[256];
- Begin With=(QuickDraw,DgInfo,ItemStuff)
-
- *
- * Initialization
- *
- call _InitGraf (thePort:A) ;Initialize QuickDraw
- call _InitFonts ;Initialize Font Manager
- MOVE.L #$0000FFFF,D0 ;Discard any previous events
- _FlushEvents ;FlushEvents(EventEvent, 0);
- _InitWindows ;Initialize Window Manager
- _InitMenus ;Initialize Menu Manager
- _TEInit ;Initialize TextEdit
- call _InitDialogs (NIL) ;Initialize Dialog Manager
- _InitCursor ;Make cursor an arrow
-
- Call _GetNewDialog:L ( #TestDLOG , Nil , -1:A )
-
- MOVE.L (A7),theDialog ;theDialog holds ptr to dialog info
- _SetPort ;Set the current grafPort
-
- MOVE.W #S_Button,D0
- call SetRequestButton
- MOVE.W #Ask_Button,D0
- call SetActionButton
- MOVE.W #0,PumpRequest
- MOVE.W #0,PumpAction
- MOVE.W #0,PumpInfo
- CLR.W Done
-
-
- * Initialize the pump driver
-
- String Pascal
- LEA #'.PumpDriver',A0
- MOVE.B #0,1(A0)
- Call _OpenDeskAcc:W ( A0:L ),PumpDriverRef
-
- MOVE.W PumpDriverRef,D0
- ADD.W #1,D0
- NEG D0
- MOVE.L UTableBase,A0
- MOVE.L (A0,D0.W*4),A0
- MOVE.L (A0),A0
- LEA dCtlQHead(A0),A0
- MOVE.L A0,DriverQueue
-
- *
- * Main loop
- *
-
- EventLoop Repeat#
- If# Done EQ.W #-1 Then.s
- MOVE.L DriverQueue,A0
- CMP.L #0,(A0)
- If# EQ Then.S
- GoTo# Quit
- EndIf#
- EndIf#
- Call _SystemTask ; Perform periodic actions defined for DAs
- Call _GetNextEvent:B(#everyEvent, myEvent:A),CC; ToolBox Event Mgr
- IF# NE THEN
- If# myEvent.what EQ.W #app2Evt then.S
- call _SysBeep ( #2:W )
- call EventProc ( myEvent.message:L )
- cycle#.S EventLoop
- EndIf#
- Call _IsDialogEvent:B ( myEvent:A ),CC
- IF# EQ THEN.S
- Switch#.S myEvent.what
- Case#.S nullEvt
- leave#.S
- Default#
- call _SysBeep ( #2:W )
- EndS#
- Else#
- Call _DialogSelect:B ( myEvent:A , DialogPtr:A , itemHit:A ),CC
- If# NE Then
- MOVE.W itemHit,D2
- Switch#.S D2
- Case#.S QuitButton
- For# D3 = #V_request DownTo #S_request Do.S
- MOVE.L #ParamBlockSize,D0
- _NewPtr ,clear
- MOVE.W PumpDriverRef,ioRefNum(A0)
- MOVE.W #Set,ActionOffset(A0)
- MOVE.W D3,RequestOffset(A0)
- CLR.L ioCompletion(A0)
- CLR.W InfoOffset(A0)
- _Status ,async
- EndF#
-
- MOVE.W #-1,Done
- MOVE.L DriverQueue,A0
-
- Leave#.S
- Case#.S ActionButton
- call ActionProc
- Leave#.S
- Case#.S S_Button..Num_Button
- MOVE.W itemHit,D0
- JSR SetRequestButton
- SUB.W #S_Button,D0
- MOVE.W D0,PumpRequest
- Leave#.S
- Case#.S Ask_Button,Set_Button
- MOVE.W itemHit,D0
- JSR SetActionButton
- SUB.W #Ask_Button,D0
- MOVE.W D0,PumpAction
- Leave#.S
- Default#
- MOVE.W #2,-(SP)
- _SysBeep
- EndS#
- EndIf#
- EndIf#
- Else#.S
- Call _IsDialogEvent:B ( myEvent:A ),CC
- Call _DialogSelect:B ( myEvent:A , DialogPtr:A , itemHit:A ),CC
- EndIf#
- Until# False
-
- *
- * User is now satisfied -- let's get out of here!
- *
- Quit:
- Call _CloseDeskAcc ( PumpDriverRef:W )
- MOVE.L A3,-(A7)
- _CloseDialog
-
- Return
- ENDP
-
- END ; of Test
-